home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
WINDOWS.PRG
< prev
Wrap
Text File
|
1992-10-09
|
47KB
|
1,293 lines
*-------------------------------------------------------------------------------
*-- Program...: WINDOWS.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 06/19/1992
*-- Notes.....: This set of functions was published in the JUNE, 1992 issue of
*-- Technotes for dBASE IV (Vol. 90). The routines were created
*-- by Adam Menkes, except for the ones added in (used by a couple
*-- of the functions) that were written by Jay Parsons (JPARSONS).
*-- For a complete explanation on how these routines work, you need
*-- to read the article in TechNotes. I have entered the routines,
*-- and added the standard DUFLP notation at the beginning, and
*-- once this issue of TN has been posted on the BORBBS, this file
*-- will be added to the 'current' version of LIBxx.ZIP.
*-------------------------------------------------------------------------------
FUNCTION Alert
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 06/01/1992
*-- Notes.......: This routine creates a popup on the screen with a title and
*-- one line message, forcing the user to notice the message.
*-- The user must use the mouse on the 'OK' pad, press <Esc> or
*-- press <Enter> to move on in the program that called this
*-- function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/19/1992 - Modified to accept the <Enter> key by Ken Mayer,
*-- also a bit better cleanup at the end (releasing things from
*-- memory, and so on).
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Alert("<cTitle>","<cMessage>")
*-- Example.....: lX = Alert("Print Aborted","You pressed <ESC>")
*-- Returns.....: Logical
*-- Parameters..: cTitle = Title line
*-- cMessage = One line message (up to 79 characters)
*-------------------------------------------------------------------------------
parameters cTitle, cMessage
private wWindow,nRow,nCol,mPad
wWindow = WINDOW() && save current Window
save screen to sTemp && save the screen
activate screen
nRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8) && center from top-bottom
nCol = 38 - (max(len(cTitle),len(cMessage))/2) && center left-right
nCol2 = max(len(cTitle),len(cMessage)) && right side?
*-- clear out a section of the screen
@nRow,nCol Clear to nRow+6,nCol+nCol2
*-- fill in a box
@nRow,nCol Fill to nRow+6,nCol+nCol2+1 color n+ && grey
*-- put a double line border around box
@nRow,nCol to nRow+6,nCol+nCol2+1 double color bg+
*-- display title
@nRow + 1,nCol + 1 + iif(len(cTitle) > len(cMessage),0,;
(len(cMessage)-len(cTitle)) / 2) say cTitle color w+/n
*-- display line
@nRow + 2, nCol + 1 to nRow + 2, nCol + nCol2 color bg+
*-- display message
@nRow + 3, nCol+1+iif(len(cTitle) > len(cMessage),;
(len(cTitle)-len(cMessage)) / 2, 0) say cMessage color w+/n
*-- define/display a very small menu (one pad)
define menu mAlert
define pad pPad1 of mAlert prompt " OK " at nRow +5,37
on selection pad pPad1 of mAlert deactivate menu
*-- added by Ken to deal with <Enter>
on key label ctrl-M keyboard "{27}"
*-- start it up
activate menu mAlert
*-- deal with user 'input'
mPad = pad()
*-- restore environment, free up RAM by releasing things
on key label ctrl-m
restore screen from sTemp
release screen sTemp
release menu mAlert
if "" # wWindow
activate window &wWindow
endif
RETURN .not. "" = mPad && not empty pad?
*-- EoF: Alert()
FUNCTION CheckBox
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 06/01/1992
*-- Notes.......: This routine brings up a one-line message, allows the user
*-- to click mouse/press <Space> on it, to change status.
*-- Pressing <Enter>/<Esc> chooses the current setting ...
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: CheckBox(<lVar>,"<cTitle>",<nRow>,<nCol>,<nASCII>)
*-- Example.....: lX = CheckBox(.t.,"OK as is?",9,10,4)
*-- Returns.....: Logical
*-- Parameters..: lVar = On or Off to start? (.t.=on, .f.=off)
*-- cTitle = Title/Message
*-- nRow = Row to place this
*-- nCol = Column ...
*-- nASCII = ascii character to use in box. (Optional)
*-- Default is 251 (√). Other suggestions include:
*-- 4 (diamond), 176 (░), 177 (▒), 178 (▓),
*-- 219 (█), 249 (∙), 250 (·), 254 (■)
*-- (Check out the ASCII chart in the language ref.)
*-------------------------------------------------------------------------------
parameters lVar, cTitle, nRow, nCol, nASCII
*-- if parameter is left blank, assign 251 (√)
nASCII = iif(pCount() = 5, nASCII, 251)
define menu mCheck
*-- loop until user does something, or presses <Esc>
do while .t.
*-- define the menu pad ...
define pad pCheck1 of mCheck at nRow,nCol prompt;
"["+iif(lVar,chr(nASCII)," ")+"] "+cTitle
on selection pad pCheck1 of mCheck deactivate menu
*-- when user presses <Enter> turn it all off ... (send <Esc> ...)
on key label ctrl-m keyboard "{27}"
*-- start 'er up
activate menu mCheck
*-- (<Esc> or <Enter>)
if lastkey() = 27
exit
endif
lVar = .not. lVar && set to opposite of current setting
enddo
*-- reset environment/release things
on key label ctrl-m
release menu mCheck
RETURN lVar
*-- EoF: CheckBox()
Function CheckBx1
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 06/01/1992
*-- Notes.......: This routine brings up a one-line message, allows the user
*-- to click mouse/press <Space> on it, to change status.
*-- Pressing <Enter>/<Esc> chooses the current setting ...
*-- This one is different, in that it does not use a menu to
*-- accomplish it's ends, but uses instead a memvar, with
*-- @/GET/READ and a picture using the multiple choice ("@M")
*-- function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: CheckBx1(<lVar>,"<cTitle>",<nRow>,<nCol>)
*-- Example.....: lX = CheckBx1(.t.,"OK as is?",9,10)
*-- Returns.....: Logical
*-- Parameters..: lVar = On or Off to start? (.t.=on, .f.=off)
*-- cTitle = Title/Message
*-- nRow = Row to place this
*-- nCol = Column ...
*-------------------------------------------------------------------------------
parameters lVar, cTitle, nRow, nCol
*-- save parts of environment ...
cFormat = set("FORMAT")
set format to
cCursor = set("CURSOR")
set cursor off
*-- define starting value of cVar ...
*-- (this is ASCII 255, √, ASCII 255, if lVar = .t., 3 spaces if lVar = .f.)
cVar = iif(lVar,chr(255)+chr(251)+chr(255),space(3))
*-- display/get, using picture
@nRow,nCol get cVar picture "@M , √ "
*-- this picture is: space, comma, chr(255), chr(251), chr(255).
@nRow,nCol + 4 say cTitle
READ
*-- reset environment
set format to &cFormat
set cursor &cCursor
RETURN .not. (cVar = chr(32)) && not a space
*-- EoF: CheckBx1()
FUNCTION DropDown
*-------------------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 06/01/1992
*-- Notes.......: This function performs a picklist of a different sort.
*-- In order to use it, you will either use an ARRAY (one-dim)
*-- or a field in a database. It holds a choice in a 'holding
*--